Celem projektu jest analiza zbioru danych dotyczących połowu śledzia oceanicznego w Europie oraz próba określenia głównych przyczyn stopniowego zmniejszania się długości śledzi. Pomiary zawierają obserwacje z ostatnich 60 lat. Wiersze są uporządkowane chronologicznie.
Zbiór danych zawiera 52582 obserwacji opisanych 16 cechami.
Podczas analizy, ze zbioru, usunięte zostały wartości brakujące. Usnięcie wartości pustych zostało dokonane częściowo poprzez wyliczenie miedany ze zbioru podobnego, a tam gdzie nie udało się znaleźć takiego zbioru całe z dalszej analizy został wykreślony cały wiersz. Przeprowadzona została interpretacja wartości cech i korelacji między nimi. W trakcie badań zależności określono, że długość śledzia jest powiązana w dużym stopniu ze zmianą temperatury przy powierzchni wody. W kolejnym kroku utworzony został model predykcji długości ryby w postaci regresora za pomocą algorytmu RandomForest. W projekcie zbadano ważność atrybutów podczas predykcji, co pomogło określić przyczyny spadku długości śledzia wyławianego w Europie:
W tej części następuje załadowanie wykorzystanych w projekcie bibliotek i wczytanie danych
library(knitr) # report generation
library(dplyr) # data manipulation
library(ggplot2) # plots visualisation
library(gridExtra) # multiple plots on grid
library(ggcorrplot) # correlation matrix visualisation
library(plotly) # interactive plots
library(caret) # data exploration lib
library(randomForest)# rf
library(tidyr)| Nazwa atrybutu | Opis |
|---|---|
| length | długość złowionego śledzia [cm] |
| cfin1 | dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 1] |
| cfin2 | dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 2] |
| chel1 | dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 1] |
| chel2 | dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 2] |
| lcop1 | dostępność planktonu [zagęszczenie widłonogów gat. 1] |
| lcop2 | dostępność planktonu [zagęszczenie widłonogów gat. 2] |
| fbar | natężenie połowów w regionie [ułamek pozostawionego narybku] |
| recr | roczny narybek [liczba śledzi] |
| cumf | łączne roczne natężenie połowów w regionie [ułamek pozostawionego narybku] |
| totaln | łączna liczba ryb złowionych w ramach połowu [liczba śledzi] |
| sst | temperatura przy powierzchni wody [°C] |
| sal | poziom zasolenia wody [Knudsen ppt] |
| xmonth | miesiąc połowu [numer miesiąca] |
| nao | oscylacja północnoatlantycka [mb] |
## length cfin1 cfin2 chel1
## Min. :19.0 Min. : 0.0000 Min. : 0.0000 Min. : 0.000
## 1st Qu.:24.0 1st Qu.: 0.0000 1st Qu.: 0.2778 1st Qu.: 2.469
## Median :25.5 Median : 0.1111 Median : 0.7012 Median : 5.750
## Mean :25.3 Mean : 0.4458 Mean : 2.0248 Mean :10.006
## 3rd Qu.:26.5 3rd Qu.: 0.3333 3rd Qu.: 1.7936 3rd Qu.:11.500
## Max. :32.5 Max. :37.6667 Max. :19.3958 Max. :75.000
## NA's :1581 NA's :1536 NA's :1555
## chel2 lcop1 lcop2 fbar
## Min. : 5.238 Min. : 0.3074 Min. : 7.849 Min. :0.0680
## 1st Qu.:13.427 1st Qu.: 2.5479 1st Qu.:17.808 1st Qu.:0.2270
## Median :21.673 Median : 7.0000 Median :24.859 Median :0.3320
## Mean :21.221 Mean : 12.8108 Mean :28.419 Mean :0.3304
## 3rd Qu.:27.193 3rd Qu.: 21.2315 3rd Qu.:37.232 3rd Qu.:0.4560
## Max. :57.706 Max. :115.5833 Max. :68.736 Max. :0.8490
## NA's :1556 NA's :1653 NA's :1591
## recr cumf totaln sst
## Min. : 140515 Min. :0.06833 Min. : 144137 Min. :12.77
## 1st Qu.: 360061 1st Qu.:0.14809 1st Qu.: 306068 1st Qu.:13.60
## Median : 421391 Median :0.23191 Median : 539558 Median :13.86
## Mean : 520366 Mean :0.22981 Mean : 514973 Mean :13.87
## 3rd Qu.: 724151 3rd Qu.:0.29803 3rd Qu.: 730351 3rd Qu.:14.16
## Max. :1565890 Max. :0.39801 Max. :1015595 Max. :14.73
## NA's :1584
## sal xmonth nao
## Min. :35.40 Min. : 1.000 Min. :-4.89000
## 1st Qu.:35.51 1st Qu.: 5.000 1st Qu.:-1.89000
## Median :35.51 Median : 8.000 Median : 0.20000
## Mean :35.51 Mean : 7.258 Mean :-0.09236
## 3rd Qu.:35.52 3rd Qu.: 9.000 3rd Qu.: 1.63000
## Max. :35.61 Max. :12.000 Max. : 5.08000
##
Zbiór danych opisujący połów śledzi zawiera 10094 niepełnych obserwacji. Cały zbiór składa się z 52582 pomiarów. W przypadku jeśli odrzucenia wszystkich niepełnych pomiarów utracilibyśmy zbyt dużo istotnych informacji.
Na podstawie wstępnej analizy atrybutów można zauważyć, że brakujące wartości występują w cechach opisujących:
W zbiorze danych można zauważyć, że wartości atrybutów często występują w podobnych grupach. W zbiorze danych warto zwrócić uwagę, że wartości atrybutów najczęściej występują w podobnych grupach. Dla przedstawienia tej zależności wybrano przykładowe trzy podzbiory sąsiadujących ze sobą elementów:
## X length cfin1 cfin2 chel1 chel2 lcop1 lcop2 fbar recr
## 1 0 23.0 0.02778 0.27785 2.46875 NA 2.54787 26.35881 0.356 482831
## 2 1 22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 3 2 25.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 4 3 25.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 5 4 24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 6 5 22.0 0.02778 0.27785 2.46875 21.43548 2.54787 NA 0.356 482831
## 7 6 24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 8 7 23.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 200 199 23.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 201 200 21.0 NA 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 202 201 23.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 203 202 20.5 0.02778 NA 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 204 203 20.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 205 204 24.0 0.02778 0.27785 NA 21.43548 2.54787 26.35881 0.356 482831
## 206 205 21.0 NA 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 207 206 20.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 208 207 24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 209 208 21.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 210 209 21.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 211 210 23.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 212 211 23.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 213 212 21.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 214 213 21.5 0.02778 NA 2.46875 21.43548 NA 26.35881 0.356 482831
## 215 214 21.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## cumf totaln sst sal xmonth nao
## 1 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 2 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 3 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 4 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 5 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 6 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 7 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 8 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 200 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 201 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 202 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 203 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 204 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 205 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 206 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 207 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 208 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 209 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 210 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 211 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 212 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 213 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 214 0.3059879 267380.8 14.30693 35.51234 9 2.8
## 215 0.3059879 267380.8 14.30693 35.51234 9 2.8
Założyć można, że brakujące elementy mają zawsze taką samą wartość jak sąsiadujące obok wiersze.
Dlatego do uzupełnienia wartości pustych w wierszach zostanie użyty algorytm sprawdzający podobieństwo wierszy. Następnie po znalezieniu podobnych wierszy wartość pusta zostanie uzupełniona medianą znalezionych wierszy.
Dla wierszy gdzie nie udało się znaleźć podobieństw zostaną one usunięte z dalszej analizy.
sledzieFilled <- sledzie
planktonAttributesNames <- c("cfin1", "cfin2", "chel1", "chel2", "lcop1", "lcop2")
missingAttributes <- c(planktonAttributesNames, "sst")
for (missingValue in missingAttributes) {
df <- sledzie[is.na(sledzie[[missingValue]]), ]
if (nrow(df) == 0) { next }
planktonAttributesToFilter <- planktonAttributesNames[planktonAttributesNames != missingValue]
for(i in 1:nrow(df)) {
row <- df[i,]
if (missingValue == "sst") {
similarGroups <- sledzie[
sledzie$totaln == row$totaln &
sledzie$sal == row$sal &
sledzie$xmonth == row$xmonth &
sledzie$nao == row$nao, ]
} else {
similarGroups <- sledzie[
sledzie[[planktonAttributesToFilter[1]]] == row[[planktonAttributesToFilter[1]]] &
sledzie[[planktonAttributesToFilter[2]]] == row[[planktonAttributesToFilter[2]]] &
sledzie[[planktonAttributesToFilter[3]]] == row[[planktonAttributesToFilter[3]]] &
sledzie[[planktonAttributesToFilter[4]]] == row[[planktonAttributesToFilter[4]]] &
sledzie[[planktonAttributesToFilter[5]]] == row[[planktonAttributesToFilter[5]]]
, ]
}
sledzieFilled[sledzieFilled$X == row$X,][[missingValue]] <- median(similarGroups[[missingValue]], na.rm = TRUE)
}
}
sledzieFilled <- sledzieFilled[complete.cases(sledzieFilled), ]## length cfin1 cfin2 chel1
## Min. :19.0 Min. : 0.0000 Min. : 0.0000 Min. : 0.000
## 1st Qu.:24.0 1st Qu.: 0.0000 1st Qu.: 0.2778 1st Qu.: 2.469
## Median :25.5 Median : 0.1111 Median : 0.7012 Median : 5.750
## Mean :25.3 Mean : 0.4460 Mean : 2.0272 Mean :10.003
## 3rd Qu.:26.5 3rd Qu.: 0.3333 3rd Qu.: 1.7936 3rd Qu.:11.500
## Max. :32.5 Max. :37.6667 Max. :19.3958 Max. :75.000
## chel2 lcop1 lcop2 fbar
## Min. : 5.238 Min. : 0.3074 Min. : 7.849 Min. :0.0680
## 1st Qu.:13.427 1st Qu.: 2.5479 1st Qu.:17.808 1st Qu.:0.2270
## Median :21.435 Median : 7.0000 Median :24.859 Median :0.3320
## Mean :21.219 Mean : 12.8064 Mean :28.424 Mean :0.3303
## 3rd Qu.:27.193 3rd Qu.: 21.2315 3rd Qu.:37.232 3rd Qu.:0.4560
## Max. :57.706 Max. :115.5833 Max. :68.736 Max. :0.8490
## recr cumf totaln sst
## Min. : 140515 Min. :0.06833 Min. : 144137 Min. :12.77
## 1st Qu.: 360061 1st Qu.:0.14809 1st Qu.: 306068 1st Qu.:13.60
## Median : 421391 Median :0.23191 Median : 539558 Median :13.86
## Mean : 520202 Mean :0.22979 Mean : 514975 Mean :13.88
## 3rd Qu.: 724151 3rd Qu.:0.29803 3rd Qu.: 730351 3rd Qu.:14.16
## Max. :1565890 Max. :0.39801 Max. :1015595 Max. :14.73
## sal xmonth nao
## Min. :35.40 Min. : 1.000 Min. :-4.89000
## 1st Qu.:35.51 1st Qu.: 5.000 1st Qu.:-1.89000
## Median :35.51 Median : 8.000 Median : 0.20000
## Mean :35.51 Mean : 7.258 Mean :-0.09208
## 3rd Qu.:35.52 3rd Qu.: 9.000 3rd Qu.: 1.63000
## Max. :35.61 Max. :12.000 Max. : 5.08000
corMatrix <- cor(sledzieFilled[, -1])
ggcorrplot(corMatrix, type = "lower", outline.col = "white") + ggtitle("Korelacja atrybutów")Na wykresie można zauważyć silną korelację ujemną między długością śledzia (length), a temperaturą przy powierzchni (sst).
ggplot(sledzieFilled, aes(x=sst, y=length)) +
ggtitle("Zmiana długości złowionego śledzia w zależności od temperatory przy powierzchni wody") +
geom_smooth() +
theme_bw()# learn = 80%, test = 20%
regPartition <- createDataPartition(y=sledzieValues$length, p=0.8, list=FALSE)
train <- sledzieValues[regPartition, ]
test <- sledzieValues[-regPartition, ]
rfGrid <- expand.grid(mtry = 1:6)
ctrl <- trainControl(method = "repeatedcv", number = 5, repeats = 2)
#uczenie
fit <- train(length ~ .,
data = train,
method = 'rf',
trControl = ctrl,
metric = "RMSE",
tuneGrid=rfGrid,
importance = TRUE,
ntree=18)
ggplot(fit) +
ggtitle("Optymalizacja parametru mtry na podstawie miary RMSE") +
theme_bw()Testowanie modelu
predictions <- predict(fit, newdata = test[-1])
modelValues <- data.frame(obs = test$length, pred = predictions)
kable(defaultSummary(modelValues))| x | |
|---|---|
| RMSE | 1.1903829 |
| Rsquared | 0.4797547 |
| MAE | 0.9387800 |
importance <- varImp(fit, scale = FALSE)
ggplot(importance) +
theme_bw() +
ggtitle("Ważność atrybutów w stosunku do atrybutu length")Analiza ważności atrybutów wskazuje, że najważniejszym atrybutem podczas predykcji była temperatura przy powierzchni wody (sst).
maxValueIndex <- 17000
ggplot(data= sledzieFilled, aes(x=X,y=length)) +
geom_vline(xintercept = maxValueIndex, color="orange", linetype = "longdash", size = 1) +
geom_smooth() +
ggtitle("Zmiana długości złowionego śledzia w czasie") +
theme_bw()ggplot(data= sledzieFilled, aes(x=X,y=sst)) +
geom_vline(xintercept = maxValueIndex, color="orange", linetype = "longdash", size = 1) +
geom_smooth() +
ggtitle("Zmiana temperatury przy powierzchni wody w czasie") +
theme_bw()ggplot(data= sledzieFilled, aes(x=X,y=lcop1)) +
geom_vline(xintercept = maxValueIndex, color="orange", linetype = "longdash", size = 1) +
geom_smooth() +
ggtitle("Zmiana liczby widłonogów gat. 1 w czasie") +
theme_bw()ggplot(data= sledzieFilled, aes(x=X,y=lcop2)) +
geom_vline(xintercept = maxValueIndex, color="orange", linetype = "longdash", size = 1) +
geom_smooth() +
ggtitle("Zmiana liczby widłonogów gat. 2 w czasie") +
theme_bw()Na podstawie powyższych badań można zauważyć, że najważniejszym czynnikiem na wpływającym długość złowionego śledzi jest temperatura przy powierzchni wody.
Nie wyklucza to wpływu również innych czynników, które mogły zaważyć na długości złowionego śledzia. W analizie korelacji było można zauważyć również inne silne korelacje, które należałoby zbadać dokładniej, aby wyciągnąć bardziej trafne wnioski.